home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / prog_gen / qshade.zip / DEMO1.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-04  |  3KB  |  119 lines
  1. (*
  2.   ──────────────────────
  3.   Tshade-Demo  unit v1.0
  4.   ──────────────────────
  5.   (c)1994   Rsc Research
  6.  
  7.   Write me at:     or on Compuserve
  8.   ────────────     ────────────────
  9.   Cédric Rime           100340,2736
  10.   Dixence 21
  11.   1950 Sion
  12.   Switzerland
  13.  
  14.  
  15.   This program is entered as Shareware.
  16.   If you find it useful, a small donation would be appreciated.(then i can take some English lessons!!!)
  17.  
  18.   Feel free to incorporate the code into your own programs.
  19.  
  20. *)
  21.  
  22. {$m 32768,0,600000}
  23. {$F-}
  24. {$N-}
  25. {$E-}
  26. {$D-}
  27. {$L-}
  28. {$Y-}
  29.  
  30.  
  31. USES crt,dos,DrawPoly,Tshade,tools;
  32.  
  33. VAR ee,gag,modif,qq,q,w,e,r,t:INTEGER;
  34.     ax,ay,az,zoom,dist:real;
  35.     px,py,pz:real;(*gravity*)
  36.     re:registers;
  37.     focus,distance:real;
  38.     s:ARRAY[0..199,0..319] OF BYTE ABSOLUTE $a000:0;
  39.     out:BYTE;
  40.  
  41.  
  42.  
  43. PROCEDURE InitGraphics;
  44. BEGIN
  45. vsinit;
  46. END;
  47.  
  48.  
  49. BEGIN
  50. out:=0;
  51. initgraphics;directvideo:=FALSE; (*Init graphic mode 320x200x256*)
  52. shadepalette(100,100,100,0,0,0); (*Build a smooth gray palette, with 100% or RGB, with 0=base color*)
  53.  
  54. qq:=0;
  55.  
  56.  
  57. clear;                           (*Clean*)
  58. loadmesh('face.msh',0.1,0.1,0.1,235);(*Load MeshFile: name,scaleXYZ,color*)
  59.  
  60. Gravity(px,py,pz);               (*Find gravity*)
  61. move_center(px,py,pz);           (*Center=gravity*)
  62.  
  63. (*AddLight;*)                    (*Addlight Vector*)
  64. LightFactor:=0.01;               (*From 100 to 0.01... try it*)
  65. LightAmbient:=30;                (*Ambient color*)
  66. ee:=0;
  67. modif:=0;
  68. ax:=1;ay:=6;
  69. midx:=160;midy:=100;             (*Display center*)
  70. xshade(40,20,20);                (*Shade from 40°X,20°Y,20°Z*)
  71. distance:=60;focus:=179;         (*Distance & focus*)
  72. REPEAT
  73. calc(ax,ay,distance,focus);      (*Rotation around X and Y angle*)
  74. redraw;                          (*Redraw*)
  75. re.ax:=3;Intr($33,re);           (*Get mouse*)
  76. FOR q:=-2 TO 2 DO s[re.dx+q,re.cx]:=255-s[re.dx+q,re.cx]; (*Draw a nice mouse cursor*)
  77. FOR q:=-2 TO 2 DO s[re.dx,re.cx+q]:=255-s[re.dx,re.cx+q];
  78. IF re.bx=1 THEN                  (*Button 1=rotate*)
  79. BEGIN
  80. ax:=re.cx*2;
  81. ay:=re.dx*2;
  82. END;
  83. IF re.bx=4 THEN                  (*Button 1&2=move center*)
  84. BEGIN
  85. midx:=re.cx;
  86. midy:=re.dx;
  87. END;
  88. IF re.bx=3 THEN                  (*Button 3=Distance & Focus*)
  89. BEGIN
  90. distance:=re.cx;
  91. focus:=   re.dx*10;
  92. END;
  93. IF re.bx=2 THEN                  (*Button 2=Shading*)
  94. BEGIN
  95. xshade(re.cx-midx,re.cx-midx,re.dx-midy);
  96. END;
  97.  
  98. IF KeyPressed THEN
  99.    CASE UpCase(ReadKey) OF
  100.     #27:out:=1;
  101.     '-':LightFactor:=LightFactor-1;
  102.     '+':LightFactor:=LightFactor+1;
  103.     '8':move_center(0,0,-1);
  104.     '2':move_center(0,0,1);
  105.     '4':move_center(-1,0,0);
  106.     '6':move_center(1,0,0);
  107.     'I':distance:=distance-2.01;
  108.     'O':distance:=distance+2.01;
  109.     'N':focus:=focus-2.01;
  110.     'M':focus:=focus+2.01;
  111.     END;
  112. (*ax:=ax+1;ay:=ay+1;*)                  (*Try this...*)
  113. UNTIL out=1;
  114. vsdone;                                 (*Restore Display*)
  115. END.
  116.  
  117.  
  118.  
  119.